perm filename SELIP.F4[SAB,LCS] blob
sn#349454 filedate 1978-04-16 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C PROGRAM SELIP
C00004 ENDMK
Cā;
C PROGRAM SELIP
DIMENSION IBUF(5000)
COMMON/FAC/JFAC,KFAC
JFAC=50
KFAC=50
CALL PLOTS(IBUF, 5000,1)
CALL PLOT(15.,14.75,-3)
A=6.
B=2.8
DO 10 J=1,20
CX=(RAN(K)*10.)-5.
CY=(RAN(K)*10.)-4.
ANG=(RAN(K)*60.)-30
PAUSE
1 CALL ELLIP2(A,B,CX,CY,ANG)
CALL DPYOUT(1)
A=.9*A
B=.9*B
10 CONTINUE
CALL PLOT(0.,-30.,-3)
CALL PLOT(0.,0.,999)
STOP
END
SUBROUTINE PLOT(X,Y,I)
COMMON/FAC/JFAC,KFAC
IF(I.GT.0)GO TO 1
C M=X
C N=Y
RETURN
2 CALL DPYOUT(1)
PAUSE
RETURN
1 IF(I.EQ.999)GO TO 2
J=(M+X)*JFAC
K=(N+Y)*KFAC
IF(I.EQ.2)CALL AVECT(J,K)
IF(I.EQ.3)CALL AIVECT(J,K)
CC NN=NN+1
CC IF(NN.LT.20)RETURN
CC NN=0
CC CALL DPYOUT(1)
END
SUBROUTINE PLOTS(I,J,K)
DIMENSION N(4000)
CALL DPYSET(1,N,4000)
END
SUBROUTINE ROTATE(X,Y,N,CX,CY,ANGLE)
DIMENSION X(1),Y(1)
THETA=ANGLE*6.2831853/360.
DO 1 I=1,N
A=X(I)-CX
B=Y(I)-CY
X(I)=A*COS(THETA)-B*SIN(THETA) + CX
1 Y(I)=A*SIN(THETA)+B*COS(THETA) + CY
RETURN
END